#  Copyright (c) 1997-2009
#  Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Darmstadt, Germany)
#  http://www.polymake.de
#
#  This program is free software; you can redistribute it and/or modify it
#  under the terms of the GNU General Public License as published by the
#  Free Software Foundation; either version 2, or (at your option) any
#  later version: http://www.gnu.org/licenses/gpl.txt.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#-------------------------------------------------------------------------------
#  $Project: polymake $$Id: basic_types 9307 2009-09-07 23:17:44Z gawrilow $

use re 'eval';

declare property_type Text {

   sub equal { $_[0] eq $_[1] }

   sub toXML {
      my ($text, $writer)=@_;
      $writer->cdata($text);
   }
}

##################################################################################

declare property_type Int : c++ (builtin => 'int') {

   method parse {
      first(extract_integer(), /\G (??{$_[1]})/xgc || &parse_error);
   }

   sub isa { is_integer(@_) }

   function construct($) {
      use integer;
      0+$_[0]
   }
}

declare property_type Bool : c++ (builtin => 'bool') {

   method parse {
      if (m{\G\s* (?i: (\d+) | (true) | false) (??{$_[1]})}xgc) {
	 (defined($1) ? $1!=0 : defined($2))+0
      } else {
	 &parse_error;
      }
   }

   sub isa { is_boolean(@_) }

   function construct($) { $_[0] ? 1 : 0 }

   sub toString { $_[0] ? "true" : "false" }
}

declare property_type Float : c++ (builtin => 'double') {

   method parse {
      first(extract_float(), /\G (??{$_[1]})/xgc || &parse_error);
   }

   sub equal {
      my ($a, $b)=@_;
      my $max=max(abs($a),abs($b));
      $max<=1e-7 || abs($a-$b)<=1e-7*$max;
   }

   sub isa { is_float(@_) }

   function construct($) { 0.0+$_[0] }

   function inf() : c++ (name => 'std::numeric_limits<double>::infinity');

   function minus_inf() { -inf() }
}

declare property_type LocalFloatEpsilon : c++ (special => 'pm::local_epsilon_keeper');

function local_epsilon($) : c++ (include => ["converters.h"]);

declare property_type Integer : c++ (operators => '++ -- bool @arith_nofloat % %= << <<= >> >>= \
                                                   **(Integer::pow) abs(abs(*)) @compare <=>(compare(*)) ') {

   function inf() : c++ (name => 'std::numeric_limits<Integer>::max', include => ["Integer.h"]);

   function minus_inf() : c++ (name => 'std::numeric_limits<Integer>::min', include => ["Integer.h"]);
}

user_function binomial(*,$) : c++ (name => 'Integer::binom', include => ["Integer.h"]);

declare property_type Rational : c++ (operators => '++ -- bool @arith_nofloat << <<= >> >>= abs(abs(*)) @compare <=>(compare(*)) ') {

   method construct(*,*) : c++ : subst_const_op( / );

   function inf() : c++ (name => 'std::numeric_limits<Rational>::max', include => ["Rational.h"]);

   function minus_inf() : c++ (name => 'std::numeric_limits<Rational>::min', include => ["Rational.h"]);
}

function numerator(lvalue_opt(Rational)) : c++;

function denominator(lvalue_opt(Rational)) : c++;

user_function isfinite(*) : c++ (include => ["Rational.h"]);

user_function isinf(*) : c++ (include => ["Rational.h"]);

user_function div_exact(*,*) : c++ (include => ["operations.h"]);

user_function gcd(*,*) : c++ (include => ["operations.h"]);

user_function lcm(*,*) : c++ (include => ["operations.h"]);

user_function fac(*) : c++ (name => 'Integer::fac', include => ["Integer.h"]);

typecheck is_ordered_field_with_unlimited_precision($) {
   my $type=shift;
   $type->abstract or croak( $type->full_name, " is not a suitable coordinate type" )
}

typecheck is_ordered_field_with_unlimited_precision(Rational) { }

typecheck is_ordered_field($) { &typechecks::is_ordered_field_with_unlimited_precision }

typecheck is_ordered_field(Float) { }

# convert to different scalar type if needed
user_function convert_to<Element>($) {
   my $target_type=typeof Element;
   if ($target_type->isa->($_[0])) {
      $_[0]
   } else {
      $target_type->construct->($_[0]);
   }
}

##################################################################################

declare property_type String : c++ (builtin => 'std::string') {

   method parse {
      if (m{\G\s* (['"])? (?(1) (.*?) (?<! \\) \1 | (.*?) ) (??{$_[1]}) }xgc) {
         $1 ? "$2" : "$3";
      } else {
	 &parse_error;
      }
   }

   sub toString {
      !length($_[0]) || $_[0] =~ /\s/ ? "'$_[0]'" : $_[0]
   }

   sub equal { $_[0] eq $_[1] }
}

declare property_type SCALAR : c++ (special => 'perl::Scalar');

##################################################################################

sub equal_arrays { is_ARRAY($_[1]) && &equal_lists }

declare property_type List<Element> : c++ (name => 'std::list', builtin => \&as_builtin) {

   method as_builtin {
      my ($self)=@_;
      my $opts=$self->param->cppoptions;
      !$opts || defined($opts->special) || $opts->builtin;
   }

   declare $list_elem_end=qr{ \s*\} (??{ pop @delimiters }) | \s }x;

   method parse {
      my ($self, $delim)=@_;
      push @delimiters, $delim;
      my $end=$#delimiters;
      /\G\s* \{ (?: $list_elem_end )? /xogc or parse_error(original_object());

      my @list;
      local_incr($nesting_level);
      while ($#delimiters>=$end) {
	 push @list, $self->param->parse->($list_elem_end);
      }
      bless \@list, original_object()->pkg;
   }

   method canonical {
      my ($self, $value)=@_;
      $self->param->canonical->($_) for @$value;
   }

   method equal {
      my ($self, $a, $b)=@_;
      my $l=$#$a;
      return 0 if $l != $#$b;
      for (my $i=0; $i<=$l; ++$i) {
	 return 0 unless $self->param->equal->($a->[$i],$b->[$i]);
      }
      1
   }

   method toString {
      my ($self, $value)=@_;
      local_incr($nesting_level);
      "{" . join(" ", map { $self->param->toString->($_) } @$value) . "}"
   }

   method trivial_constructor {
      my $self=shift;
      my ($obj, $arg0);
      if (@_!=1 || !is_ARRAY($arg0=$_[0])) {
	 $obj=[ @_ ];
      } elsif (is_object($arg0)) {
	 $obj=[ @$arg0 ];
      } else {
	 $obj=$arg0;
      }
      bless $obj, $self->pkg;
      if (!$trusted_value && defined($self->canonical)) {
         $self->canonical->($obj);
      }
      $obj
   }

   method nontrivial_constructor {
      my $self=shift;
      my $obj=bless [ map { new_object($self->param,$_) } @_==1 && is_ARRAY($_[0]) ? @{$_[0]} : @_ ], $self->pkg;
      if (!$trusted_value && defined($self->canonical)) {
         $self->canonical->($obj);
      }
      $obj
   }

   method param_is_derived {
      my ($self, $other)=@_;
      $self->name eq $other->name &&
      $self->application == $other->application &&
      UNIVERSAL::isa($other->param->pkg, $self->param->pkg)
   }

   method init {
      my ($self)=@_;
      $self->dimension=1;
      $self->construct=
         $self->param->dimension || defined($self->param->construct)
	 ? \&nontrivial_constructor
	 : \&trivial_constructor;
      unless (defined($self->param->canonical)) {
         undef $self->canonical;
      }
      unless (defined($self->param->equal)) {
         $self->equal=\&equal_arrays;
      }
      unless (defined($self->param->toString)) {
         $self->toString=sub { "{@{$_[0]}}" };
      }
      if (defined($self->param->construct)) {
         $self->isa=sub : method {
            is_object($_[1]) and &PropertyType::isa_fallback || param_is_derived($_[0],$_[1]->type)
         };
      }
      $self->toXML=
         defined($self->param->toXML)
         ? sub : method { nontrivialArray_toXML((shift)->param, @_) }
         : sub : method { trivialArray_toXML((shift)->param, @_) };

      $self->define_basic_operators;
   }
}
##################################################################################

declare property_type Array<Element> : List<Element> : c++ (builtin => \&as_builtin) {

   my $array_elem_end =qr{ \s*> (??{ pop @delimiters }) | \s }x;
   my $array1_elem_end=qr{ (?m:\s*\Z) (??{ pop @delimiters }) | (?<=\n) | [ \t]*\n }x;
   my $array0_elem_end=qr{ (?m:[ \t]*$) (??{ pop @delimiters }) | [ \t] }x;

   method parse {
      my ($self, $delim)=@_;
      push @delimiters, $delim;
      my $end=$#delimiters;
      my $nested=$nesting_level;
      local $nesting_level= $self->dimension==2 ? 0 : $nested+1;
      my @array;
      my $elem_end=
	 $nested
	 ? (/\G\s*< (?: $array_elem_end )? /xogc || parse_error(original_object()), $array_elem_end) :
         $self->dimension>1
	 ? (/\G $array1_elem_end /xogc, $array1_elem_end)
	 : (/\G $array0_elem_end /xogc, $array0_elem_end);
      while ($#delimiters >= $end) {
	 push @array, $self->param->parse->($elem_end);
      }
      bless \@array, original_object()->pkg;
   }

   method init {
      my ($self)=@_;
      &List::init;
      $self->dimension= $self->param->dimension==1 && $self->param->pkg !~ /^Polymake::common::Array_/ ? 1 : $self->param->dimension+1;
      $self->toString=
         defined($self->param->toString)
	 ? ($self->dimension>2
	    ? sub : method {
		 my ($self, $value)=@_;
		 local_incr($nesting_level);
		 ($nesting_level>1 && "<") .
		 join("", map { $self->param->toString->($_) } @$value) .
		 ($nesting_level>1 && ">\n")
	      } :
            $self->dimension==2
	    ? sub : method {
		 my ($self, $value)=@_;
                 my $nested=$nesting_level;
		 local $nesting_level=0;
		 ($nested>0 && "<") .
		 join("", map { enforce_nl($self->param->toString->($_)) } @$value) .
		 ($nested>0 && ">\n")
	      }
	    : sub : method {
	         my ($self, $value)=@_;
	         local_incr($nesting_level);
	         ($nesting_level>1 && "<") .
	         join(" ", map { $self->param->toString->($_) } @$value) .
	         ($nesting_level>1 && ">")
	      })
         : sub {
	      ($nesting_level>0 && "<") . "@{$_[0]}" . ($nesting_level>0 && ">")
	   };
   }
}

function permuted_cxx(*,*) : c++ (name => 'permuted', include => ["permutations.h"]);

function permuted_inv_cxx(*,*) : c++ (name => 'permuted_inv', include => ["permutations.h"]);

function select_subset(*,*) : c++ (name => 'select', include => ["IndexedSubset.h"]);

function permuted(Array, $) {
   my ($array, $perm)=@_;
   my $proto=$array->type;
   if ($proto->cppoptions->builtin) {
      local $Core::PropertyType::trusted_value=1;
      $proto->construct->(@$array[ @$perm ]);
   } else {
      permuted_cxx(@_);
   }
}

function permuted_inv(Array, $) {
   my ($array, $perm)=@_;
   my $proto=$array->type;
   if ($proto->cppoptions->builtin) {
      my @inv; $#inv=$#$array;
      $inv[$perm->[$_]]=$array->[$_] for 0..$#inv;
      local $Core::PropertyType::trusted_value=1;
      $proto->construct->(\@inv);
   } else {
      permuted_inv_cxx(@_);
   }
}

function permuted_elements(Array, $) {
   my ($array, $perm)=@_;
   local $Core::PropertyType::trusted_value=1;
   $array->type->construct->(map { permuted($_,$perm) } @$array);
}

function find_permutation(*,*) : c++ (include => ["permutations.h"]);

function permutation_cycles(*) : c++ (include => ["permutations.h"]) : returns(Array<List<Int>>);

declare property_type ARRAY : Array<SCALAR> : c++ (special => 'perl::Array');

##################################################################################

declare property_type Iterator<*> : c++ {

   # inherit the overloaded ++, bool, and deref
   @ISA=qw( Polymake::Core::CPlusPlus::Iterator );
}

declare property_type SparseIterator<*> : Iterator : c++ {

   method index() : c++;
}

function entire(*) : c++ : returns(Iterator<*>);

##################################################################################

declare property_type Set<Element=Int> : c++ (operators => '@sets @compare') {

   method contains(*) : c++;

   method size() : c++;
}

function incl(Set,Set) : c++ (include => ["Set.h"]);

function range(Int,Int) : c++ (include => ["Set.h"]);

function permuted(Set, *) : c++;

function permuted_inv(Set, *) : c++;

declare property_type PowerSet<Element=Int> : Set<Set<Element>> : c++;

function permuted(PowerSet, *) : c++;

function permuted_inv(PowerSet, *) : c++;

function scalar2set(*) : c++ (include => ["Set.h"]);

# allow to write ~[0,1,2] in contexts where a Set<Int> is expected
function _construct_set($) : subst_const_op( ~ ) {
   if ($#{$_[0]} > 0) {
      new Set($_[0])
   } else {
      scalar2set(@{$_[0]});
   }
}

declare property_type FacetList : c++;

declare property_type Map<Key,Value> : c++ (operators => '@string') {

   method equal {
      my ($self, $m1, $m2)=@_;
      return 0 unless keys(%$m1) == keys(%$m2);
      my ($pk, $pv)=@{$self->param};
      while (my ($k1, $v1, $k2, $v2)=(each(%$m1), each(%$m2))) {
         return 0 unless $pk->equal->($k1,$k2) && $pv->equal->($v1,$v2);
      }
      1
   }
}

declare property_type HashSet<Element> : c++ (name => 'hash_set', operators => '+= -= ^=');

declare property_type HashMap<Key,Value> : c++ (name => 'hash_map');

##################################################################################

declare property_type Vector<Element> : c++ (operators => '@arith | |= @compare') {

   method dim() : c++;

   method slice(*) : lvalue_opt : c++;

   method slice($$) : lvalue_opt : c++;

   method div_exact(*) : lvalue : c++;
}

property_type Vector<Float> {
   
   type()->equal=sub { (typeof Array<Float>)->equal->(@_) };
}

function permuted(Vector, *) : c++;

function permuted_inv(Vector, *) : c++;

function _convert_to<Element>(*) : c++ (name => 'convert_to');

function gcd(Vector) : c++;

# convert to different element type if needed
user_function convert_to<Element>(Vector) {
   my $target_type=typeof Element;
   if ($_[0]->type->param==$target_type) {
      $_[0]
   } else {
      _convert_to<Element>($_[0]);
   }
}


##################################################################################

declare property_type Matrix<Element> : c++ (operators => '@arith | |= @compare') {

   method construct(Int,Int) : c++;

   method construct(Vector+) {
      my $proto=shift;
      my $M=$proto->construct->(scalar(@_), $_[0]->dim);
      my $i=0;
      $M->[$i++]=$_ for @_;
      $M;
   }

   method rows() : c++;

   method cols() : c++;

   method row($) : lvalue_opt : c++;

   method col($) : lvalue_opt : c++;

   method minor(*,*) : lvalue_opt : c++;

   method operator($,$) : lvalue_opt : c++;

   method diagonal() : lvalue_opt : c++;

   method anti_diagonal() : lvalue_opt : c++;

   method div_exact(*) : lvalue : c++;
}

property_type Matrix<Float> {

   type()->equal=sub { (typeof Array<Array<Float>>)->equal->(@_) };
}

declare property_type all_rows_or_cols : c++ (name => 'pm::all_selector', builtin => enum { All }, include => ["Matrix.h"]);

function vector2row(Vector) : c++ (include => ["Matrix.h"]);

function vector2col(Vector) : c++ (include => ["Matrix.h"]);

function permuted_rows(Matrix, *) : c++;

function permuted_inv_rows(Matrix, *) : c++;

function permuted_cols(Matrix, *) : c++;

function permuted_inv_cols(Matrix, *) : c++;

user_function convert_to<Element>(Matrix) {
   my $target_type=typeof Element;
   if ($_[0]->type->param==$target_type) {
      $_[0]
   } else {
      _convert_to<Element>($_[0]);
   }
}

user_function transpose(Matrix) : c++ (name => 'T');

user_function det(Matrix) : c++ (include => ["linalg.h"]);

user_function rank(Matrix) : c++ (include => ["linalg.h"]);

user_function inv(Matrix) : c++ (include => ["linalg.h"]);

user_function basis(Matrix) : c++ (include => ["linalg.h"]);

user_function unit_matrix<Element=Rational>($) : c++ (include => ["linalg.h"]);

user_function unit_vector<Element=Rational>($$) : c++ (include => ["linalg.h"]);

user_function zero_vector<Element=Rational>($) : c++ (include => ["linalg.h"]);

user_function ones_vector<Element=Rational>($) : c++ (include => ["linalg.h"]);

user_function null_space(Matrix) : c++ (include => ["linalg.h"]);

user_function null_space(Vector) : c++ (include => ["linalg.h"]);

user_function lineality_space(Matrix) : c++ (include => ["linalg.h"]);

user_function lin_solve(Matrix,Vector) : c++ (include => ["linalg.h"]);

# check whether both matrices are bases of the same linear subspace
user_function equal_bases(Matrix, Matrix) {
   my ($M1, $M2)=@_;
   return $M1->rows==$M2->rows && !(null_space($M1) * transpose($M2));
}

user_function dense(Vector) { shift }

user_function dense(Matrix) { shift }

function permutation_matrix(Matrix) : c++ (include => ["permutations.h"]);

##################################################################################

declare property_type NonSymmetric : c++ (special => 'NonSymmetric', include => ["IncidenceMatrix.h"]);

declare property_type Symmetric : c++ (special => 'Symmetric', include => ["IncidenceMatrix.h"]);

declare property_type SparseVector<Element> : Vector<Element> : c++;

declare property_type SparseMatrix<Element, Sym=NonSymmetric> : Matrix<Element> : c++ {

   method squeeze() : non_const : void : c++;

   method squeeze_rows() : non_const : void : c++;

   method squeeze_cols() : non_const : void : c++;
}

function entire(SparseVector) : c++ : returns(SparseIterator<*>);

user_function dense<Element>(SparseVector<Element>) { new Vector<Element>(shift) }

user_function dense<Element>(SparseMatrix<Element>) { new Matrix<Element>(shift) }

##################################################################################
declare property_type IncidenceMatrix<Sym=NonSymmetric> : c++ (operators => '@sets @compare | |= / /=') {

   method construct(Int,Int) : c++;

   method rows() : c++;

   method cols() : c++;

   method row($) : lvalue_opt : c++;

   method col($) : lvalue_opt : c++;

   method minor(*,*) : lvalue_opt : c++;

   method operator($,$) : lvalue_opt : c++;

   method squeeze() : non_const : void : c++;

   method squeeze_rows() : non_const : void : c++;

   method squeeze_cols() : non_const : void : c++;
}

function permuted_rows(IncidenceMatrix *) : c++;

function permuted_inv_rows(IncidenceMatrix *) : c++;

function permuted_cols(IncidenceMatrix *) : c++;

function permuted_inv_cols(IncidenceMatrix *) : c++;

user_function transpose(IncidenceMatrix) : c++ (name => 'T');

function toVector<Scalar>(Set $) : c++ (name => 'same_element_sparse_vector', include => ['SparseVector.h']);

function toMatrix<Scalar>(IncidenceMatrix) : c++ (name => 'same_element_sparse_matrix', include => ['SparseMatrix.h']);

##################################################################################
declare property_type Directed : c++ (special => 'Directed', include => ["Graph.h"]);

declare property_type Undirected : c++ (special => 'Undirected', include => ["Graph.h"]);

declare property_type Graph<Dir=Undirected> : c++ (operators => '@sets == !=') {

   method nodes() : c++;

   method edges() : c++;

   method add_node() : c++ : non_const;

   method delete_node($) : non_const : void : c++;

   method edge($$) : non_const : c++;

   method delete_edge($$) : non_const : void : c++;

   method contract_edge($$) : non_const : void : c++;

   method squeeze() : non_const : void : c++;

   method edge_exists($$) : c++;

   method in_edges($) : c++ : returns(EdgeList<*>);

   method out_edges($) : c++ : returns(EdgeList<*>);

   method adjacent_nodes($) : lvalue_opt : c++;

   method in_adjacent_nodes($) : lvalue_opt : c++;

   method out_adjacent_nodes($) : lvalue_opt : c++;

   method in_degree($) : c++;

   method out_degree($) : c++;

   method degree($) : c++;

   method has_gaps() : c++;

   method dim() : c++;

   method construct(Int) : c++;

   method construct(IncidenceMatrix) : c++;

   sub toXML {
      my $g=shift;
      if ($g->has_gaps) {
	 my ($writer, @attr)=@_;
	 $writer->startTag("m", @attr, dim => $g->dim);
	 my $type=Int->type;
	 for (my $n=entire(common::nodes($g)); $n; ++$n) {
	    trivialArray_toXML($type, $n->out_adjacent_nodes, $writer, i=>$$n);
	 }
	 $writer->endTag("m");
      } else {
	 my $am=adjacency_matrix($g);
	 $am->type->toXML->($am,@_);
      }
   }

   method init_edge_map(lvalue(*)) : void : c++;
}

function adjacency_matrix(lvalue_opt(Graph)) : c++;

function permuted_nodes(Graph, *) : c++;

function renumber_nodes(Graph) : c++;

declare property_type EdgeList<*> : c++;

declare property_type EdgeIterator<*> : Iterator : c++ {

   method from_node() : c++;

   method to_node() : c++;
}

function entire(EdgeList) : c++ : returns(EdgeIterator<*>);

function edges(Graph) : c++ : returns(EdgeList<*>);

declare property_type NodeSet<*> : c++;

declare property_type NodeIterator<*> : Iterator : c++ {

   method out_edges() : c++ : returns(EdgeList<*>);

   method in_edges() : c++ : returns(EdgeList<*>);

   method adjacent_nodes() : c++;

   method out_adjacent_nodes() : c++;

   method in_adjacent_nodes() : c++;

   method degree() : c++;

   method in_degree() : c++;

   method out_degree() : c++;
}

function nodes(Graph) : c++ : returns(NodeSet<*>);

function entire(NodeSet) : c++ : returns(NodeIterator<*>);

# the maps may contain gaps, hence got to use iterators
sub equal_maps {
   my ($elem_proto, $m1, $m2)=@_;
   @$m1==@$m2 and do {
      for (my ($it1,$it2)=(entire($m1), entire($m2)); $it1; ++$it1, ++$it2) {
	 $elem_proto->equal->($$it1, $$it2) or return 0;
      }
      1
   }
}

declare property_type NodeMap<Dir,Element> : Array<Element> : \
   c++ ( include => ["Graph.h"], default_constructor => 0 ) {

   method construct(Graph<Dir>) : c++;

   method construct(Graph<Dir>, $@) {
      my ($proto, $graph)=splice @_,0,2;
      CPlusPlus::assign_any($proto->construct->($graph), @_);
   }

   method equal { equal_maps((shift)->param->[1],@_); }
}

declare property_type EdgeMap<Dir,Element> : Array<Element> : \
   c++ ( include => ["Graph.h"], default_constructor => 0 ) {

   method construct(Graph<Dir>) : c++;

   method construct(Graph<Dir>, $@) {
      my ($proto, $graph)=splice @_,0,2;
      CPlusPlus::assign_any($proto->construct->($graph), @_);
   }

   method equal { equal_maps((shift)->param->[1],@_); }
}

declare property_type NodeHashMap<Dir,Element> : \
   c++ ( include => ["Graph.h"], default_constructor => 0 ) {

   method construct(Graph<Dir>) : c++;

   method construct(Graph<Dir>, $@) {
      my ($proto, $graph)=splice @_,0,2;
      CPlusPlus::assign_any($proto->construct->($graph), @_);
   }

   method equal { equal_maps((shift)->param->[1],@_); }
}

declare property_type EdgeHashMap<Dir,Element> : \
   c++ ( include => ["Graph.h"], default_constructor => 0 ) {

   method construct(Graph<Dir>) : c++;

   method construct(Graph<Dir>, $@) {
      my ($proto, $graph)=splice @_,0,2;
      CPlusPlus::assign_any($proto->construct->($graph), @_);
   }

   method equal { equal_maps((shift)->param->[1],@_); }
}

function createNodeMap<Element,Dir>(Graph<Dir>) { new NodeMap<Dir,Element>(shift) }

function createEdgeMap<Element,Dir>(Graph<Dir>) { new EdgeMap<Dir,Element>(shift) }

function createNodeHashMap<Element,Dir>(Graph<Dir>) { new NodeHashMap<Dir,Element>(shift) }

function createEdgeHashMap<Element,Dir>(Graph<Dir>) { new EdgeHashMap<Dir,Element>(shift) }

function induced_subgraph(Graph, *) : c++ ( include => ["IndexedSubgraph.h"] );

##################################################################################

declare property_type Tuple<...> {

   my $tuple_elem_end=qr{ \s*\) (??{ pop @delimiters }) | \s }x;
   my $tuple0_elem_end=qr{ (?m:\s*\Z) (?{ pop @delimiters }) | \s }x;

   method parse {
      my ($self, $delim)=@_;
      push @delimiters, $delim;
      my $end=$#delimiters;
      my @tuple;
      local_incr($nesting_level);
      my $elem_end=
         $nesting_level>1
	 ? (/\G\s*\( (?: $tuple_elem_end )?/xogc || parse_error(original_object()), $tuple_elem_end)
	 : (/\G $tuple0_elem_end /xogc, $tuple0_elem_end);
      my $l=$#{$self->param};
      foreach my $elem (@{$self->param}) {
	 if ($#delimiters < $end) {
	    $#tuple=$#{$self->param};	# fill the rest with undef
	    last;
	 }
	 push @tuple, $elem->parse->($elem_end);
      }
      parse_error(original_object()) if $#delimiters>=$end;
      bless \@tuple, original_object()->pkg;
   }

   method canonical {
      my ($self, $value)=@_;
      die "too many elements\n" if $#$value > $#{$self->param};
      for (my $i=0; $i<=$#$value; ++$i) {
	 if (defined($value->[$i])) {
	    $self->param->[$i]->canonical->($value->[$i]);
	 }
      }
   }

   method toString {
      my ($self, $value)=@_;
      local_incr($nesting_level);
      my $text=$nesting_level>1 && "(";
      for (my $i=0; $i<=$#$value; ++$i) {
	 $text .= ($i>0 && substr($text,-1,1) !~ /\s/ && " ") . $self->param->[$i]->toString->($value->[$i]);
      }
      $text.($nesting_level>1 && ")");
   }

   method trivial_constructor {
      my $self=shift;
      my ($obj, $arg0);
      if (@_ != 1 || !is_ARRAY($arg0=$_[0])) {
	 $obj=\@_;
      } elsif (is_object($arg0)) {
	 $obj=[ @$arg0 ];
      } else {
	 $obj=$arg0;
      }
      if ($#$obj != $#{$self->param}) {
	 croak( "wrong number of arguments given to constructor of ", $self->full_name );
      }
      bless $obj, $self->pkg;
      if (!$trusted_value && defined($self->canonical)) {
	 $self->canonical->($obj);
      }
      $obj
   }

   method nontrivial_constructor {
      my $self=shift;
      my $single_arg= @_ == 1 && is_ARRAY(my $arg0=$_[0]);
      if (($single_arg ? $#$arg0 : $#_) != $#{$self->param}) {
	 croak( "wrong number of arguments given to constructor of ", $self->full_name );
      }
      my $i=0;
      my $obj=bless [ map { new_object($self->param->[$i++],$_) } $single_arg ? @$arg0 : @_ ], $self->pkg;
      if (!$trusted_value && defined($self->canonical)) {
	 $self->canonical->($obj);
      }
      $obj
   }

   method equal {
      my ($self, $a, $b)=@_;
      my $l=$#$a;
      return 0 if $l != $#$b;
      for (my $i=0; $i<=$l; ++$i) {
	 return 0 unless $self->param->[$i]->equal->($a->[$i],$b->[$i]);
      }
      1
   }

   method params_are_derived {
      my ($self, $other)=@_;
      $self->name eq $other->name &&
      $self->application == $other->application &&
      do {
	 for (my ($i,$l)=(0,$#{$self->param}); $i<=$l; ++$i) {
	    return 0 unless UNIVERSAL::isa($other->param->[$i]->pkg, $self->param->[$i]->pkg);
	 }
	 1
      }
   }

   method init {
      my ($self)=@_;
      $self->dimension=1;
      my ($need_canonical, $need_toString, $need_toXML, $need_special_constructor, $need_equal);
      foreach my $elem (@{$self->param}) {
	 $need_canonical ||= defined($elem->canonical);
	 $need_toString ||= defined($elem->toString);
	 $need_toXML ||= defined($elem->toXML);
	 $need_special_constructor ||= defined($elem->construct);
	 $need_equal ||= defined($elem->equal);
	 assign_max($self->dimension, $elem->dimension);
      }
      unless ($need_canonical) {
	 undef $self->canonical;
      }
      unless ($need_toString) {
	 $self->toString=sub { $nesting_level ? "(@{$_[0]})" : "@{$_[0]}" };
      }
      $self->toXML=$need_toXML
         ? sub : method { nontrivialComposite_toXML((shift)->param, @_) }
	 : \&trivialComposite_toXML;
      $self->construct= $need_special_constructor ? \&nontrivial_constructor : \&trivial_constructor;
      if ($need_special_constructor) {
	 $self->isa=sub : method {
            is_object($_[1]) and &PropertyType::isa_fallback || params_are_derived($_[0],$_[1]->type)
         };
      }
      unless ($need_equal) {
	 $self->equal=\&equal_arrays;
      }
      $self->define_basic_operators;
   }
}

##################################################################################

declare property_type Pair<First,Second> : Tuple<First,Second> : \
        c++ (name => 'std::pair', builtin => \&as_builtin, include => ["polymake.h"], fields => [qw(first second)]) {

   method as_builtin {
      my ($self)=@_;
      foreach (@{$self->param}) {
	 my $opts=$_->cppoptions;
	 return 0 if $opts && !$opts->builtin;
      }
      1
   }
}

##################################################################################

# change the type of the object:
# only downcast (to a derived type) and upcast (to a ancestor type) are allowed

user_function cast<Target>(Core::Object) { (shift)->cast_me(typeof Target); }


# Local Variables:
# mode: perl
# c-basic-offset:3
# End:
